home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / PowerMacOberon feb96 / Source / MarkElems.Mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1996-01-19  |  6.6 KB  |  199 lines  |  [TEXT/.Ob4]
  1. Syntax10.Scn.Fnt
  2. StampElems
  3. Alloc
  4. 19 Jan 96
  5. Syntax10b.Scn.Fnt
  6. Syntax10i.Scn.Fnt
  7. Syntax10m.Scn.Fnt
  8. MODULE MarkElems;  (** HM 
  9. IMPORT Files, Fonts, Display, Input, Viewers, Texts, TextFrames, TextPrinter, MenuViewers, Oberon;
  10. CONST
  11.     middle = 1; right = 0;
  12.     pixel = LONG(10000);
  13.     Elem* = POINTER TO ElemDesc;
  14.     ElemDesc* = RECORD (Texts.ElemDesc)
  15.         key*: LONGINT
  16.     END;
  17.     Frame = POINTER TO FrameDesc;
  18.     FrameDesc = RECORD (TextFrames.FrameDesc)
  19.         e: Elem
  20.     END;
  21.     backF*: TextFrames.Frame;    (**source frame of most recent link*)
  22.     backE*: Texts.Elem;    (**most recently activated link elem*)
  23.     icon, invIcon: Display.Pattern; (* x = 0, y = 3, w = 12, h = 8 *)
  24.     w: Texts.Writer;
  25. PROCEDURE ShowKey (e: Elem);
  26.     VAR t: Texts.Text; v: MenuViewers.Viewer; f: Frame; x, y: INTEGER;
  27. BEGIN
  28.     t := TextFrames.Text(""); Texts.WriteInt(w, e.key, 0); Texts.Append(t, w.buf);
  29.     NEW(f); f.e := e; TextFrames.Open(f, t, 0);
  30.     Oberon.AllocateSystemViewer(0, x, y);
  31.     v := MenuViewers.New(
  32.         TextFrames.NewMenu("MarkElem", "System.Close  MarkElems.Update "),
  33.         f, TextFrames.menuH, x, y)
  34. END ShowKey;
  35. PROCEDURE ShowPos (f: TextFrames.Frame; pos: LONGINT);
  36.     VAR beg, end, delta: LONGINT;
  37. BEGIN delta := 200;
  38.     LOOP beg := f.org; end := TextFrames.Pos(f, f.X + f.W, f.Y);
  39.         IF (beg <= pos) & (pos < end) OR (delta = 0) THEN EXIT END;
  40.         TextFrames.Show(f, pos - delta); delta := delta DIV 2
  41. END ShowPos;
  42. PROCEDURE GoBack;
  43.     VAR r: Texts.Reader; pos: LONGINT;
  44. BEGIN
  45.     IF backF # NIL THEN
  46.         Texts.OpenReader(r, backF.text, 0);
  47.         LOOP Texts.ReadElem(r);
  48.             IF r.eot THEN EXIT END;
  49.             IF r.elem = backE THEN
  50.                 pos := Texts.Pos(r); ShowPos(backF, pos); TextFrames.SetSelection(backF, pos-1, pos);
  51.                 backF := NIL; EXIT
  52.             END
  53.         END
  54. END GoBack;
  55. PROCEDURE GetDsr (f: Display.Frame; pos: LONGINT; fnt: Fonts.Font; VAR dsr: INTEGER);
  56.     VAR p: TextFrames.Parc; beg: LONGINT;
  57. BEGIN
  58.     IF f = NIL THEN
  59.         IF fnt = NIL THEN dsr := 0 ELSE dsr := - fnt.minY END
  60.     ELSE
  61.         TextFrames.ParcBefore(f(TextFrames.Frame).text, pos, p, beg);
  62.         dsr := SHORT(p.dsr DIV TextFrames.Unit)
  63. END GetDsr;
  64. PROCEDURE Handle* (e: Texts.Elem; VAR m: Texts.ElemMsg);
  65.     VAR e1: Elem; x, y, dsr: INTEGER; keys: SET;
  66. BEGIN
  67.     WITH e: Elem DO
  68.         WITH m: Texts.FileMsg DO
  69.             IF m.id = Texts.load THEN Files.ReadLInt(m.r, e.key)
  70.             ELSE (*Texts.store*) Files.WriteLInt(m.r, e.key)
  71.             END
  72.         | m: Texts.CopyMsg DO
  73.             NEW(e1); Texts.CopyElem(e, e1); e1.key := e.key; m.e := e1
  74.         | m: Texts.IdentifyMsg DO
  75.             m.mod := "MarkElems"; m.proc := "Alloc"
  76.         | m: TextFrames.DisplayMsg DO
  77.             IF ~m.prepare THEN
  78.                 GetDsr(m.frame, m.pos, m.fnt, dsr);
  79.                 Display.CopyPattern(Display.white, icon, m.X0, m.Y0+dsr, Display.paint)
  80.             END
  81.         | m: TextPrinter.PrintMsg DO
  82.             IF m.prepare THEN e.W := 1 ELSE e.W := 12 * pixel END
  83.         | m: TextFrames.TrackMsg DO
  84.                 IF middle IN m.keys THEN
  85.                     GetDsr(m.frame, m.pos, m.fnt, dsr);
  86.                     Display.CopyPattern(Display.white, icon, m.X0, m.Y0+dsr, Display.invert);
  87.                     Display.CopyPattern(Display.white, invIcon, m.X0, m.Y0+dsr, Display.invert);
  88.                     REPEAT Input.Mouse(keys, x, y); m.keys := m.keys + keys;
  89.                         Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y)
  90.                     UNTIL keys = {};
  91.                     Display.CopyPattern(Display.white, invIcon, m.X0, m.Y0+dsr, Display.invert);
  92.                     Display.CopyPattern(Display.white, icon, m.X0, m.Y0+dsr, Display.invert);
  93.                     IF m.keys = {middle} THEN GoBack
  94.                     ELSIF m.keys = {middle, right} THEN ShowKey(e)
  95.                     END
  96.                 END
  97.         ELSE
  98.         END
  99. END Handle;
  100. PROCEDURE New* (): Elem;
  101.     VAR e: Elem;
  102. BEGIN
  103.     NEW(e); e.W := 12 * pixel; e.H := 11 * pixel; e.handle := Handle; e.key := Oberon.Time(); RETURN e
  104. END New;
  105. PROCEDURE MarkProcs*;
  106.     VAR v: Viewers.Viewer; t: Texts.Text; s: Texts.Scanner; pos: LONGINT; ch: CHAR; key: LONGINT; mark: Elem;
  107. BEGIN
  108.     v := Oberon.MarkedViewer();
  109.     IF v.dsc.next IS TextFrames.Frame THEN
  110.         t := v.dsc.next(TextFrames.Frame).text;
  111.         Texts.OpenScanner(s, t, 0); Texts.Scan(s); key := Oberon.Time();
  112.         WHILE ~ s.eot DO
  113.             IF (s.class = Texts.Name) & (s.s = "PROCEDURE") THEN
  114.                 pos := Texts.Pos(s);
  115.                 Texts.Scan(s);
  116.                 IF s.class = Texts.Char THEN
  117.                     IF (s.c = "^") OR (s.c = "*") OR (s.c = "-") THEN pos := Texts.Pos(s); Texts.Scan(s)
  118.                     ELSIF s.c = "(" THEN
  119.                         REPEAT Texts.Scan(s) UNTIL (s.class = Texts.Char) & (s.c = ")") OR s.eot;
  120.                         pos := Texts.Pos(s); Texts.Scan(s)
  121.                     END
  122.                 END;
  123.                 IF s.class = Texts.Name THEN
  124.                     Texts.OpenReader(s, t, pos); Texts.Read(s, ch);
  125.                     IF (s.elem = NIL) OR ~(s.elem IS Elem) THEN
  126.                         mark := New(); mark.key := key; INC(key);
  127.                         Texts.WriteElem(w, mark); Texts.Insert(t, pos, w.buf)
  128.                     END;
  129.                     Texts.OpenScanner(s, t, pos+1)
  130.                 END
  131.             END;
  132.             Texts.Scan(s)
  133.         END
  134. END MarkProcs;
  135. PROCEDURE ShowNext*;
  136.     VAR f: Display.Frame; tf: TextFrames.Frame; pos: LONGINT; r: Texts.Reader;
  137. BEGIN
  138.     IF Oberon.FocusViewer # NIL THEN
  139.         f := Oberon.FocusViewer.dsc.next;
  140.         IF (f # NIL) & (f IS TextFrames.Frame) THEN
  141.             tf := f(TextFrames.Frame);
  142.             IF tf.hasCar THEN pos := tf.carloc.pos ELSE pos := 0 END;
  143.             Texts.OpenReader(r, tf.text, pos); Texts.ReadElem(r);
  144.             WHILE ~r.eot & ~(r.elem IS Elem) DO Texts.ReadElem(r) END;
  145.             IF r.eot THEN TextFrames.RemoveCaret(tf)
  146.             ELSE pos := Texts.Pos(r); ShowPos(tf, pos); TextFrames.SetCaret(tf, pos)
  147.             END
  148.         END
  149. END ShowNext;
  150. PROCEDURE Alloc*;
  151.     VAR e: Elem;
  152. BEGIN
  153.     NEW(e); e.handle := Handle; Texts.new := e
  154. END Alloc;
  155. PROCEDURE Update*;
  156.     VAR f: Frame; t: Texts.Text; s: Texts.Scanner; r: Texts.Reader; ch: CHAR;
  157. BEGIN
  158.     IF (Oberon.Par.frame = Oberon.Par.vwr.dsc) & (Oberon.Par.frame.next IS Frame) THEN
  159.         f := Oberon.Par.frame.next(Frame);
  160.         Texts.OpenScanner(s, f.text, 0); Texts.Scan(s);
  161.         IF s.class = Texts.Int THEN
  162.             f.e.key := s.i;
  163.             t := Oberon.Par.frame(TextFrames.Frame).text;
  164.             Texts.OpenReader(r, t, t.len-1); Texts.Read(r, ch);
  165.             IF ch = "!" THEN Texts.Delete(t, t.len-1, t.len) END
  166.         END
  167. END Update;
  168. PROCEDURE Insert*;
  169.     VAR m: TextFrames.InsertElemMsg;
  170. BEGIN
  171.     m.e := New(); Viewers.Broadcast(m)
  172. END Insert;
  173. PROCEDURE InitIcon;
  174.     VAR line: ARRAY 9 OF SET;
  175. BEGIN
  176.     line[1] := {4..7};
  177.     line[2] := {3, 8};
  178.     line[3] := {2, 9};
  179.     line[4] := {2, 5, 6, 9};
  180.     line[5] := {2, 5, 6, 9};
  181.     line[6] := {2, 9};
  182.     line[7] := {3, 8};
  183.     line[8] := {4..7};
  184.     icon := Display.NewPattern(line, 12, 8);
  185.     line[1] := {};
  186.     line[2] := {4..7};
  187.     line[3] := {3..8};
  188.     line[4] := {3, 4, 7, 8};
  189.     line[5] := {3, 4, 7, 8};
  190.     line[6] := {3..8};
  191.     line[7] := {4..7};
  192.     line[8] := {};
  193.     invIcon := Display.NewPattern(line, 12, 8)
  194. END InitIcon;
  195. BEGIN
  196.     Texts.OpenWriter(w); backF := NIL;
  197.     InitIcon
  198. END MarkElems.
  199.